home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbcmsg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-26  |  14.8 KB  |  411 lines
  1. (*===========================================================================*)
  2. (* Copy message                                                              *)
  3. (* Make Carbon Copies                                                        *)
  4. (*                                                                           *)
  5. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  6. (*   rights reserved.                                                        *)
  7. (*                                                                           *)
  8. (*===========================================================================*)
  9.  
  10. {$O+}
  11.  
  12. {$UNDEF DEBUG_DIST} (* Debug processing messages with a dist list *)
  13.  
  14. UNIT BBCMSG;
  15.  
  16. INTERFACE
  17.  
  18.   USES
  19.     CRT,
  20.     bbcopy,
  21.     bbdummy,
  22.     bbmdata,
  23.     bbmess,
  24.     bbmf,
  25.     bbmisc,
  26.     bbmisc2,
  27.     bbsdata,
  28.     bbsto,
  29.     bbstr,
  30.     bbtask;
  31.  
  32. PROCEDURE copy_msg(m_num          : WORD;
  33.                    to_addr        : STRING;
  34.                    tell_user      : BOOLEAN;
  35.                    assign_new_bid : BOOLEAN);
  36.  
  37. PROCEDURE make_cc;
  38.  
  39. IMPLEMENTATION
  40.  
  41. (*===========================================================================*)
  42. (* Copy message                                                              *)
  43. (*===========================================================================*)
  44.  
  45.  
  46. PROCEDURE copy_msg(m_num          : WORD;
  47.                    to_addr        : STRING;
  48.                    tell_user      : BOOLEAN;
  49.                    assign_new_bid : BOOLEAN);
  50.  
  51.   VAR
  52.     msg_ptr        : msg_index_ptr;
  53.     f_str          : file_name_str;
  54.     t_str          : file_name_str;
  55.     w_str          : STRING;
  56.  
  57.   BEGIN
  58.  
  59.     (*-----------------------------------------------------------------------*)
  60.     (* Find the message                                                      *)
  61.     (*-----------------------------------------------------------------------*)
  62.  
  63.     msg_ptr := find_msg(m_num);
  64.  
  65.     IF msg_ptr = NIL THEN
  66.       BEGIN;
  67.         send_message(message_rmc_nf);
  68.         active_tcb^.error_sw := TRUE;
  69.         EXIT;
  70.       END;
  71.  
  72.     (*-----------------------------------------------------------------------*)
  73.     (* Set the message data from the old message into the new one            *)
  74.     (*-----------------------------------------------------------------------*)
  75.  
  76.     WITH active_tcb^ DO
  77.       curr_msg := msg_ptr^;
  78.  
  79.     (*-----------------------------------------------------------------------*)
  80.     (* Process the "to" data                                                 *)
  81.     (*-----------------------------------------------------------------------*)
  82.  
  83.     send_msg_to_process(to_addr);
  84.     IF active_tcb^.error_sw THEN
  85.       EXIT;
  86.  
  87.     (*-----------------------------------------------------------------------*)
  88.     (* Set the new fields                                                    *)
  89.     (*-----------------------------------------------------------------------*)
  90.  
  91.     WITH active_tcb^.curr_msg.msg_i_mb DO
  92.       BEGIN;
  93.  
  94.         msg_type    := msg_ptr^.msg_i_mb.msg_type;
  95.         msg_flag    := 0;
  96.         msg_from    := msg_ptr^.msg_i_mb.msg_from;
  97.         msg_from_at := msg_ptr^.msg_i_mb.msg_from_at;
  98.         msg_dt_in   := msg_ptr^.msg_i_mb.msg_dt_in;
  99.         msg_dt_orig := msg_ptr^.msg_i_mb.msg_dt_orig;
  100.         msg_no_orig := msg_ptr^.msg_i_mb.msg_no_orig;
  101.  
  102.       END;
  103.  
  104.     (*-----------------------------------------------------------------------*)
  105.     (* Build the from and to file names                                      *)
  106.     (*-----------------------------------------------------------------------*)
  107.  
  108.     t_str := opt_block.msg_file_dir + active_tcb^.port_chan_s + '.IN';
  109.  
  110.     STR(m_num, f_str);
  111.     f_str := opt_block.msg_file_dir + 'BB' + f_str + '.MSG';
  112.  
  113.     (*-----------------------------------------------------------------------*)
  114.     (* Print the message header in format #1                                 *)
  115.     (*-----------------------------------------------------------------------*)
  116.  
  117.     IF tell_user THEN
  118.       BEGIN;
  119.         send_msg_header(1);
  120.         send_tnc_data_str(header_msg_block(msg_ptr, 1) + cr);
  121.       END;
  122.  
  123.     (*-----------------------------------------------------------------------*)
  124.     (* Copy the file.  Print any error message that appears                  *)
  125.     (*-----------------------------------------------------------------------*)
  126.  
  127.     w_str := copy_file_binary(f_str, t_str, TRUE);
  128.     IF w_str <> '' THEN
  129.       BEGIN;
  130.         send_tnc_data_str(w_str + cr);
  131.         active_tcb^.error_sw := TRUE;
  132.         EXIT;
  133.       END;
  134.  
  135.     (*-----------------------------------------------------------------------*)
  136.     (* Mark new bid                                                          *)
  137.     (*-----------------------------------------------------------------------*)
  138.  
  139.     IF assign_new_bid THEN
  140.       BEGIN;
  141.         active_tcb^.curr_msg.msg_i_mb.msg_bid := #1;
  142.         active_tcb^.curr_msg.msg_i_mb.msg_flag :=
  143.                        active_tcb^.curr_msg.msg_i_mb.msg_flag OR mf_bid_change;
  144.       END;
  145.  
  146.     (*-----------------------------------------------------------------------*)
  147.     (* Add the message                                                       *)
  148.     (*-----------------------------------------------------------------------*)
  149.  
  150.     add_msg(t_str, TRUE);
  151.     make_cc;
  152.  
  153.     (*-----------------------------------------------------------------------*)
  154.     (* Tell user                                                             *)
  155.     (*-----------------------------------------------------------------------*)
  156.  
  157.     IF NOT active_tcb^.tcb_abbs THEN
  158.       send_message(message_added_msg);
  159.  
  160.   END;
  161.  
  162. (*===========================================================================*)
  163. (* Make multiple copies of a message                                         *)
  164. (*                                                                           *)
  165. (*      This should really be part of ADD_MSG but can't because of           *)
  166. (*      "CIRCULAR" paths.  We use recursiveness to make the copies           *)
  167. (*                                                                           *)
  168. (*===========================================================================*)
  169.  
  170. PROCEDURE make_cc;
  171.  
  172.   VAR
  173.     b              : BOOLEAN;
  174.     cc_data        : STRING;
  175.     cc_file        : TEXT;
  176.     cc_file_name   : file_name_str;
  177.     i              : BYTE;
  178.     j              : BYTE;
  179.     master_msg     : WORD;
  180.     master_msg_ptr : msg_index_ptr;
  181.     str_ptr        : ^STRING;
  182.     this_act       : action_msg_ptr;
  183.     word_data      : bb_addr_str;
  184.  
  185.   LABEL
  186.     read_loop;
  187.  
  188.   (*=========================================================================*)
  189.   (* Clean up subroutine                                                     *)
  190.   (*=========================================================================*)
  191.  
  192.   PROCEDURE clean_up;
  193.     BEGIN;
  194.  
  195.       active_tcb^.tcb_make_cc := FALSE;
  196.  
  197.       {$I-}
  198.       CLOSE(cc_file);
  199.       {$I+}
  200.  
  201.     END;
  202.  
  203.   (*=========================================================================*)
  204.   (* Open a file                                                             *)
  205.   (*=========================================================================*)
  206.  
  207.   FUNCTION open_file : BOOLEAN;
  208.     BEGIN;
  209.  
  210.       (*---------------------------------------------------------------------*)
  211.       (* Find any actions to set a distribution list                         *)
  212.       (*---------------------------------------------------------------------*)
  213.  
  214.       this_act := NIL;
  215.  
  216.       REPEAT
  217.         msg_action_check(@active_tcb^.curr_msg, this_act);
  218.       UNTIL (this_act = NIL)
  219.                       OR ((this_act^.action_type AND action_msg_distr) <> 0);
  220.  
  221.       (*---------------------------------------------------------------------*)
  222.       (* If we found an action then do it                                    *)
  223.       (*---------------------------------------------------------------------*)
  224.  
  225.       IF (this_act <> NIL)
  226.                    AND ((this_act^.action_type AND action_msg_invert) = 0) THEN
  227.         BEGIN;
  228.  
  229.           (*-----------------------------------------------------------------*)
  230.           (* Locate the name to use                                          *)
  231.           (*-----------------------------------------------------------------*)
  232.  
  233.           i       := LENGTH(this_act^.action_info) + 1;
  234.           str_ptr := ADDR(this_act^.action_info[i]);
  235.  
  236.           cc_file_name := str_ptr^;
  237.  
  238.         END;
  239.  
  240.       (*---------------------------------------------------------------------*)
  241.       (* Build the file name.  Truncate the address if necessary             *)
  242.       (*---------------------------------------------------------------------*)
  243.  
  244.       IF POS('.', cc_file_name) = 0 THEN
  245.         BEGIN;
  246.           cc_file_name := SUBSTR(cc_file_name, 1, 8);
  247.  
  248.           cc_file_name := opt_block.msg_file_dir + cc_file_name + '.CC';
  249.         END;
  250.  
  251.       (*---------------------------------------------------------------------*)
  252.       (* Open the file for input                                             *)
  253.       (*---------------------------------------------------------------------*)
  254.  
  255.       ASSIGN(cc_file, cc_file_name);
  256.       {$I-}
  257.       RESET(cc_file);
  258.       {$I+}
  259.  
  260.       (*---------------------------------------------------------------------*)
  261.       (* If the open fails then nothing is necessary                         *)
  262.       (*---------------------------------------------------------------------*)
  263.  
  264.       open_file := IORESULT = 0;
  265.  
  266.     END;
  267.  
  268.   (*=========================================================================*)
  269.   (* Main line                                                               *)
  270.   (*=========================================================================*)
  271.  
  272.   BEGIN;
  273.  
  274.     WITH active_tcb^, active_tcb^.curr_msg.msg_i_mb DO
  275.       BEGIN;
  276.  
  277.         (*-------------------------------------------------------------------*)
  278.         (* Prevent loops                                                     *)
  279.         (*-------------------------------------------------------------------*)
  280.  
  281.         IF tcb_make_cc THEN
  282.          EXIT;
  283.  
  284.         (*-------------------------------------------------------------------*)
  285.         (* Don't do distribution lists                                       *)
  286.         (*-------------------------------------------------------------------*)
  287.  
  288.         {$IFDEF DEBUG_DIST}
  289.           WRITELN('CC process 2 -- ', (msg_flag AND mf_fwd_list) <> 0);
  290.         {$ENDIF}
  291.  
  292.         IF (msg_flag AND mf_fwd_list) <> 0 THEN
  293.           EXIT;
  294.  
  295.         (*-------------------------------------------------------------------*)
  296.         (* Get the assumed file name                                         *)
  297.         (*-------------------------------------------------------------------*)
  298.  
  299.         cc_file_name := msg_to_at;
  300.         IF (cc_file_name = '') OR (cc_file_name = opt_block.this_bb_sign) THEN
  301.           cc_file_name := msg_to;
  302.  
  303.         (*-------------------------------------------------------------------*)
  304.         (* If we can't open then we are done                                 *)
  305.         (*-------------------------------------------------------------------*)
  306.  
  307.         IF NOT open_file THEN
  308.           EXIT;
  309.  
  310.         (*-------------------------------------------------------------------*)
  311.         (* Show that we are in cc                                            *)
  312.         (*-------------------------------------------------------------------*)
  313.  
  314.         tcb_make_cc := TRUE;
  315.  
  316.         (*-------------------------------------------------------------------*)
  317.         (* Loop making copies                                                *)
  318.         (*-------------------------------------------------------------------*)
  319.  
  320.         master_msg := msg_number;
  321.  
  322. read_loop:
  323.  
  324.         WHILE (NOT EOF(cc_file)) DO
  325.           BEGIN;
  326.  
  327.             task_switch;
  328.  
  329.             (*---------------------------------------------------------------*)
  330.             (* Read a line and strip blanks                                  *)
  331.             (*---------------------------------------------------------------*)
  332.  
  333.             READLN(cc_file, cc_data);
  334.  
  335.             strip_var(cc_data, 'B');
  336.  
  337.             upcase_str_var(cc_data);
  338.  
  339.             IF comment_line(cc_data) THEN
  340.               GOTO read_loop;
  341.  
  342.             (*---------------------------------------------------------------*)
  343.             (* See if a special statement.  If so handle                     *)
  344.             (*---------------------------------------------------------------*)
  345.  
  346.             word_data := subwordl(cc_data, 1, 8);
  347.  
  348.             IF (word_data = 'OK') OR (word_data = 'NOT_OK') THEN
  349.               IF (NOT verify_auth_list(@cc_data, uid_data.user_id)) OR
  350.                  (NOT verify_auth_list(@cc_data,
  351.                                              curr_msg.msg_i_mb.msg_from)) THEN
  352.                 BEGIN;
  353.                   clean_up;
  354.                   EXIT;
  355.                 END
  356.               ELSE
  357.                 word_data := '';
  358.  
  359.             (*---------------------------------------------------------------*)
  360.             (* If data exists the process it.  A check is made to try to     *)
  361.             (* not send the msg back to the originator                       *)
  362.             (*---------------------------------------------------------------*)
  363.  
  364.             IF (word_data <> '') AND (word_data <> uid_data.user_id)
  365.                            AND (word_data <> curr_msg.msg_i_mb.msg_from) THEN
  366.               BEGIN;
  367.  
  368.                 i := POS(' NONEW$', cc_data);
  369.                 b := i > 0;
  370.  
  371.                 IF b THEN
  372.                   FOR j := i TO i + 7 DO
  373.                     cc_data[j] := ' ';
  374.  
  375.                 copy_msg(master_msg, cc_data, FALSE, NOT b);
  376.  
  377.                 IF error_sw THEN
  378.                   BEGIN;
  379.                     clean_up;
  380.                     EXIT;
  381.                   END;
  382.  
  383.               END;
  384.  
  385.           END; (*----- End read cc list loop --------------------------------*)
  386.  
  387.       END;
  388.  
  389.     (*-----------------------------------------------------------------------*)
  390.     (* Clear up things                                                       *)
  391.     (*-----------------------------------------------------------------------*)
  392.  
  393.     clean_up;
  394.  
  395.     (*-----------------------------------------------------------------------*)
  396.     (* Mark the original as done                                             *)
  397.     (*-----------------------------------------------------------------------*)
  398.  
  399.     master_msg_ptr := find_msg(master_msg);
  400.  
  401.     active_tcb^.curr_msg := master_msg_ptr^;
  402.  
  403.     WITH master_msg_ptr^.msg_i_mb DO
  404.       msg_flag := msg_flag OR mf_fwd;
  405.  
  406.     update_msg(master_msg_ptr);
  407.  
  408.   END;
  409.  
  410. END.
  411.